perm filename RGB2IC.SAI[DD,BGB] blob sn#032891 filedate 1973-07-03 generic text, type T, neo UTF8
00100	BEGIN "RGB"
00200	
00300	REQUIRE "PROLOG.HDR[1,PDQ]" SOURCE_FILE;
00400	REQUIRE "COMSUB.HDR[1,PDQ]" SOURCE_FILE;
00500	REQUIRE "PICIO.HDR[1,PDQ]" SOURCE_FILE;
00600	REQUIRE "PICOPS.HDR[1,PDQ]" SOURCE_FILE;
00700	
00800	PICTURE PIC1,PIC2,PIC3[0:PICMAX];
00900	INTEGER SCALE;		STRING NAM;
01000	
01100	SIMPLE PROCEDURE RGB2IC(PICTURE PIC1,PIC2,PIC3);
01200	BEGIN	INTEGER SIZX,SIZY,SIZL,PT1,OPT1,PT2,OPT2,PT3,OPT3,XPT2,
01300			HINT,INT,INT1,INT2,PT,LIN,R,G,B,R1,R2,G1,G2,B1,B2,X,Y;
01400	
01500		SIZX←PIC1[SIZEX];  SIZY←PIC1[SIZEY];  SIZL←PIC1[SIZEL];
01550	OUTSTR(" SIZX "&CVS(SIZX)&" SIZY "&CVS(SIZY)&" SIZL "&CVS(SIZL)&CRLF);
01600		OPT1←PIC1[PTR];    OPT2←PIC2[PTR];    OPT3←PIC3[PTR];
01650	OUTSTR(" OPT1 "&CVOS(OPT1)&" OPT2 "&CVOS(OPT2)&" OPT3 "&CVOS(OPT3)&CRLF);
01700		HINT←1 LSH (PIC1[BIT]-1);
01800		FOR LIN←1 STEP 1 UNTIL SIZY DO
01900		BEGIN	PT1←OPT1;  PT2←OPT2;  PT3←OPT3;
02000			FOR PT←1 STEP 2 UNTIL SIZX DO
02100			BEGIN	R1←ILDB(PT1);  G1←ILDB(PT2);  B1←ILDB(PT3);
02200				INT1←R1+G1+B1;
02300				DPB(INT1 DIV 3,PT1);
02400				XPT2←PT2;
02500				R2←ILDB(PT1);  G2←ILDB(PT2);  B2←ILDB(PT3);
02600				INT2←R2+G2+B2;
02700				DPB(INT2 DIV 3,PT1);
02800				R←R1+R2;       G←G1+G2;       INT←INT1+INT2;
02900				X←(3*R-INT) DIV 6 + HINT;
03000				Y←(3*G-INT) DIV 6 + HINT;
03100				DPB(X,XPT2);   DPB(Y,PT2);
03200			END;
03300			OPT1←OPT1+SIZL;   OPT2←OPT2+SIZL;   OPT3←OPT3+SIZL;
03400		 END;
03500	END "RGB2IC";
03600	
03700	WHILE TRUE DO
03800	BEGIN	NAM←STRIN("FILE NAME=");
03900		RECPIC(PIC1,0,"R"&NAM);
04000		RECPIC(PIC2,0,"G"&NAM);
04100		RECPIC(PIC3,0,"B"&NAM);
04200		RGB2IC(PIC1,PIC2,PIC3);
04300		SNDPIC(PIC1,NULL,"I"&NAM);
04400		SNDPIC(PIC2,NULL,"C"&NAM);
04500		PICREL(PIC1);	PICREL(PIC2);	PICREL(PIC3);
04600	END;
04700	
04800	END "RGB"